Optional Framework.f

Requires SEKI
Requires Vectors
Requires Quicksort
Requires Kagi
Requires SORA\Motifs
Requires SORA\Tilemap-display
Requires SORA\Sprites

Only Forth Definitions

{
   rendering

      general idea:
        sort into opaques and transparents and put in an array we build each frame, as subarrays that
        we store pointers to in the display list - also, sort them

      first, go through trees and create the sorted lists   - UPDATE
         later this could also be a time to do special processing, since all objects are touched

      then given 2 lists,  - RENDER ( transparents count opaques count -- )
        calls UPDATE
        execute each motif's 'SHOW
          motifs are responsible for rendering their lists.  the correct list for the current pass is given with THEM

      go through opaque subarray, then transparent.
         execute the motif's render code - typically:
            1) It just displays something - like a tilemap or a text box or gui element for instance
             or
            2) It sets some state, itterates through the current subarray (depending on the pass),
               then does some completion stuff, such as drawing a vertex buffer
               some motifs would let their children just draw themselves, like with gui elements

   prefabs
      Spritebatch - all children are interpreted as sprites, one texture per spritebatch,
         can enable rotation on a sprite-by-sprite basis.  No spritebatch-wide transform
      Tilemap - any children are ignored, one texture per tilemap, unlimited dimensions,
         any tile size - though Ged enforces 8x8 multiples.  Entire Tilemap can be transformed
      Panel - each child draws itself using the Drawing API, entire GUI can be transformed
                moved to Gui.f
      2DCamera - used to transform all children and serve as a reference for culling -
         objects that are camera aware will use the CAM reference, which 2DCamera will set before
         rendering its children.

   vocabulary partitioning

      necessary for complex programs that won't be using OOP

      separate vocab (COMPS) holds our vocab partition accessor words

      COMPONENT: define or open an already defined component, for adding definitions
      OPEN <comp> - make the component available
      CLOSE <comp>
      USING <comp> - open component, ensure Forth is the context
}

Struct
   cell field ->start
   cell field ->length
End-struct /List

:macro list-count  2v@ ;

[Motif]
   cell blk property hidden?
   cell blk property 'sort
   /List blk property opaques
   /List blk property transparents
   cell blk property 'show

\ Built up each frame
5000 Stack: opaque-buf
5000 Stack: transparent-buf

: end-frame
   seki-end-frame
   opaque-buf clear-stack
   transparent-buf clear-stack
   poll-all ;

0 value pass  \  0 = opaque, 1 = transparent

: them
   pass if transparents else opaques then list-count ;

: init-list   ( addr list -- )
   2dup ->start !   ->length off   drop ;

: list+   ( list -- )
   1 swap ->length +! ;

: sort-for-display
   'sort @ execute ;

: funnel
   me each:[ hidden? @ not if @alpha if
      @alpha 255 < if
         me transparent-buf push  @parent << transparents list+ >>
      else
         me opaque-buf push  @parent << opaques list+ >>
      then
      children? if sort-for-display then
   then then ;] ;

: sift
   me each:[ hidden? @ not if @alpha if
      me opaque-buf push  @parent << opaques list+ >>
      children? if sort-for-display then
   then then ;] ;

: sort-front-to-back
   sort:[ ->transform ->z @ ;] ;

: sort-back-to-front
   sort:[ ->transform ->z @ negate ;] ;

: sort-by-z
   sift
   opaques list-count sort-back-to-front ;

: sort-2d
   funnel
   opaques list-count sort-front-to-back
   transparents list-count sort-back-to-front ;

: update  ( motif -- )
   <<
      opaque-buf top cell+ opaques init-list
      transparent-buf top cell+ transparents init-list
      sort-for-display
   >> ;


: shows  ( addr count -- )
   0 ?do @+ show loop drop ;

: render  ( root-motif -- )
   dup update
   0 to pass dup show
   1 to pass glDepthMask( GL_FALSE ) show
   glDepthMask( GL_TRUE ) ;


\ Components

: vocab>wid  cell+ @ ;

wordlist constant comps

:[] comp:[    comps +order execute comps -order ;

: Component:
   comp:[ >in @
      exists if >in ! ' >body vocab>wid +order definitions exit then
   >in !
   definitions vocabulary lastbody vocab>wid +order definitions
   ;] ;
: open   comp:[ ' >body vocab>wid +order ;] ;
: close  comp:[ ' >body vocab>wid -order also forth definitions ;] ;
: knows  open also forth definitions ;

\ Spritebatches

2D GL_QUADS Vbuf: 2d-quads-vbuf

[Motif]
   \ spritebatch
   cell blk property image
   \ spritebatch children
   cell blk property subimage   \ address
   cell blk property flip  \ bitmask:  1 = horizontal, 2 = vertical

: show-as-sprite ( motif -- )
   <<  subimage @  @flip  flip @  xor  to (flip)  subimage @  transform  sprite >> ;

: spritebatch ( <<me>> image -- )
   image !
\   ['] sort-by-z 'sort !
   ['] sift 'sort !
   show:[
      me update
      image @ bind-image
      them nip 4 * 2d-quads-vbuf draw:[
         them 0 ?do @+ show-as-sprite loop drop
      ;]
   ;] ;

: Spritebatch:  ( image -- <name> )
   Motif:  lastbody << spritebatch >> ;

{ comp: Spritebatch
close Spritebatch previous definitions
}

\ Tilemap
[Motif]
   cell blk property tileset
   cell blk property mapdata
   cell blk property mapw
   cell blk property maph
   cell blk property scrollx
   cell blk property scrolly

Struct
   cell field ->image
End-struct /Image-based

\ tileset
/Image-based inherit
   cell field ->tilew
   cell field ->tileh
End-struct /Tileset

: Tileset:   ( tilew tileh image -- )
   Create , swap , , ;

: tile-dims   tileset @ ->tilew 2v@ ;
: tile-w    tileset @ ->tilew @ ;
: tile-h    tileset @ ->tileh @ ;

: tile[]   ( col row tilemap -- addr )
   << mapw @ * + 2* mapdata @ + >> ;

: show-as-tilemap ( <<me>> -- )
   scrollx @ .>s tile-w /mod
   scrolly @ .>s tile-h /mod  locals| row ofsy col ofsx |
   push-modelview
   transform gl-transform3d
   ofsx negate ofsy negate at
   tile-dims 2dup to (tileh) to (tilew)
      tileset @ ->image @ bind-image-texture
   col row me tile[]
      mapw @
      w @ .>s tile-w / ofsx if 1 + then
      h @ .>s tile-h / ofsy if 1 + then
      draw-tilemap
   pop-modelview ;

: tilemap ( tileset mapw maph mapdata <<me>> -- )
   mapdata ! mapw 2v! tileset !
   mapw 2v@ 2s>. tile-dims 2s>. 2scale w 2v!
   show:[ show-as-tilemap ;] ;


\ max pixel dims are 65535.0 x 65535.0
\ mapw & maph specified here are in TILES.
: Tilemap:  ( tileset mapw maph -- <name> )
   Motif: lastbody << here >r 2dup * 2* allot r> tilemap >> ;

: scroll   ( x. y.  tilemap -- )
   << scrollx 2v! >> ;

: +scroll   ( x. y.  tilemap -- )
   << scrollx 2v+! >> ;

\ 2DCamera - probably will become a 2dview and 2dcamera
0 Value cam

: 2DCamera ( <<me>> -- )
   ['] sift 'sort !
   show:[
      them nip if
         gl-depthtest gl-disable
         glDepthMask( GL_FALSE )
         push-modelview
         glTranslatef( x @ negate .>f  y @ negate .>f  0e )
         glRotatef( rotation @ .>f 0e fdup 1e )
         glScalef( sx @ .>f  sy @ .>f  1e )
         cam >q  me to cam
         them shows
         q> to cam
         pop-modelview
      then
   ;] ;

